home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / CODEAPP.ZIP / PRINTDLG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-16  |  9.4 KB  |  370 lines
  1. unit Printdlg;
  2. (*-----
  3.     File: PRINTDLG.PAS for Project CODEAPP.DPR
  4.     Sends a text file to printer
  5. -----*)
  6.  
  7. {.$DEFINE Testing} {enable for out to file}
  8.  
  9. interface
  10.  
  11. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  12.   StdCtrls, ExtCtrls, SysUtils, Dialogs, Spin, Printers, FileFunc;
  13.  
  14. type
  15.   TPRNformatDlg = class(TForm)
  16.     OKBtn: TBitBtn;
  17.     CancelBtn: TBitBtn;
  18.     HelpBtn: TBitBtn;
  19.     Bevel1: TBevel;
  20.     LineNumbering: TCheckBox;
  21.     PrintPitch: TRadioGroup;
  22.     HasTitle: TCheckBox;
  23.     LastPageFirst: TCheckBox;
  24.     GroupBox1: TGroupBox;
  25.     Label2: TLabel;
  26.     Label3: TLabel;
  27.     Panel2: TPanel;
  28.     AutoWidth: TCheckBox;
  29.     LinesLabel: TLabel;
  30.     SpinEditLast: TSpinEdit;
  31.     SpinEditFirst: TSpinEdit;
  32.     procedure HelpBtnClick(Sender: TObject);
  33.     procedure OKBtnClick(Sender: TObject);
  34.     procedure AutoWidthClick(Sender: TObject);
  35.     procedure SpinEditFirstChange(Sender: TObject);
  36.     procedure SpinEditLastChange(Sender: TObject);
  37.     procedure HasTitleClick(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.     FirstPage, LastPage : integer;
  41.     PrintLength: Integer;               {lines per page}
  42.     Pages: Integer;
  43.     procedure AutoSetCPI;
  44.     procedure UpdateLineRange;
  45.   public
  46.     { Public declarations }
  47.     TextList: TStringList;
  48.     page_width : Integer;  {print width in # of columns}
  49.     pcancel: boolean;
  50.     procedure SetPrintFactors;
  51.     procedure PrintTheFile(const FileSpec: String; FilesName: TLabel);
  52.   end;
  53.  
  54.  
  55. const
  56.   LinesPerPage = 55;               {nominal lines per page}
  57.  
  58. var
  59.   PRNformatDlg: TPRNformatDlg;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. const
  66.   Widths: array[0..3] of integer = (40, 80, 132, 160);
  67.  
  68. procedure TPRNformatDlg.PrintTheFile(const FileSpec: String;
  69.    FilesName: TLabel);
  70. {-Print the file to the printer}
  71. const
  72.   Esc = ^[;                       { ASCII Escape }
  73.   BoldOff = Esc+'(s0B';           { Bold Print Off }
  74.   BoldOn = Esc+'(s3B';            { Bold Print On }
  75.   PRNDateTimeFormat = 'mmm d, yy  h:mm:ss am/pm';
  76. var
  77.   Page: Integer;
  78.   PrintText: System.Text;
  79.   PrinterMode: Integer; {print format mode}
  80.   S, HeaderStr1, FooterStr: string;
  81.   F: TSearchRec;
  82.   oldMode: Word;
  83.  
  84.   procedure SelectPrintMode(const col : Integer);
  85.   var
  86.     M: string;
  87.   begin
  88.     case col of
  89.        40 : M := '(s5H';     { 5 cpi }
  90.        80 : M := '(s10H';    { 10 cpi }
  91.       132 : M := '(s16.67H'; { 16.67 cpi }
  92.       160 : M := '(s20H';    { 20 cpi }
  93.     else
  94.       exit; {.. nothing}
  95.     end;                          { case }
  96.     write(PrintText, Esc, M);
  97.   end;
  98.  
  99.   procedure InitPrinter;
  100.   {- laser printer setup: select PC-8 font; perf skip on, 66 lines }
  101.   const
  102.     PrnInitStr = Esc+'(10U'+Esc+'&l1L'+Esc+'&l66P';
  103.   begin
  104.     write(PrintText, PrnInitStr);
  105.   end;
  106.  
  107.   procedure WriteHeader;
  108.   begin
  109.     if HasTitle.Checked then
  110.     begin
  111.       if page_width <> 80 then  { restore it }
  112.         SelectPrintMode(80); { 10.0 cpi }
  113.       writeln(PrintText, BoldOn, HeaderStr1, BoldOff);
  114.       writeln(PrintText);
  115.       if page_width <> 80 then
  116.         SelectPrintMode(page_width);
  117.     end;
  118.   end;
  119.  
  120.   procedure WriteFooter;
  121.   begin
  122.     if HasTitle.Checked then
  123.     begin
  124.       if page_width <> 80 then  { restore it }
  125.         SelectPrintMode(80); { 10.0 cpi }
  126.       writeln(PrintText);
  127.       writeln(PrintText, BoldOn, FooterStr,
  128.       'Page ':65-Length(FooterStr),Page,' of ',Pages, BoldOff);
  129.     end;
  130.     write(PrintText, ^L); {form feed}
  131.   end;
  132.  
  133.   procedure OutputPage;
  134.   {-Output a print page}
  135.   var
  136.     Line, firstline, lastline : Integer;
  137.     rlines: Integer;
  138.     S: string;
  139.   begin
  140.     firstline := ((Page-1) * PrintLength) +1;
  141.     if Page >= Pages then
  142.       lastline := TextList.Count
  143.     else
  144.       lastline := Page * PrintLength;
  145.  
  146.     WriteHeader;
  147.     for Line := firstline to lastline do
  148.     begin
  149.       if LineNumbering.Checked then
  150.         write(PrintText, Line:5,': ');
  151.       writeln(PrintText, TextList.Strings[Line-1]);
  152.       Application.ProcessMessages;
  153.     end;
  154.     if Page >= Pages then {last page}
  155.       if HasTitle.Checked then
  156.       begin
  157.         rlines := TextList.Count mod PrintLength;
  158.         if rlines <> 0 then
  159.         begin
  160.           for Line := rlines+1 to PrintLength do {feed out last page}
  161.             writeln(PrintText);
  162.         end
  163.       end;
  164.     WriteFooter;
  165.     S := 'File: '+ExtractFileName(FileSpec)+
  166.       '  Page:'+IntToStr(Page);
  167.     FilesName.Caption := S;
  168.   end; {OutputPage}
  169.  
  170. begin {PrintTheFile}
  171.   FooterStr := '  Listing date: '+ FormatDateTime(DateTimeFormat,
  172.     Now);
  173.   HeaderStr1 := '';
  174.   if GetFileInfo(FileSpec, F) then
  175.   try
  176.     HeaderStr1 := Format('  %13s   File Size: %6s   File Date: %s',
  177.       [F.Name, FormatFloat(',##########', F.Size),
  178.       FormatDateTime(PRNDateTimeFormat,
  179.       FileDateToDateTime(F.Time))]);
  180.   except
  181.     ShowMessage('Unable to get file data for print-out');
  182.     exit;
  183.   end;
  184.  
  185.   oldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  186.   {$IFDEF Testing}
  187.   AssignFile(PrintText, ChangeFileExt(FileSpec, '.lst'));
  188.   {$ELSE}
  189.   AssignFile(PrintText, 'PRN');
  190.   {$ENDIF}
  191.   try
  192.     Rewrite (PrintText);
  193.     try
  194.       InitPrinter; { Init the printer }
  195.       Screen.Cursor := crHourGlass;
  196.       SelectPrintMode(page_width);
  197.  
  198.       { Get range of pages}
  199.       FirstPage := SpinEditFirst.Value;
  200.       LastPage := SpinEditLast.Value;
  201.  
  202.       { Print Pages}
  203.       if LastPageFirst.Checked then {backwards}
  204.         for Page := LastPage downto FirstPage do
  205.         begin
  206.           OutputPage;
  207.           if pcancel then break;  {get out}
  208.         end
  209.       else
  210.         for Page := FirstPage to LastPage do
  211.         begin
  212.           OutputPage;
  213.           if pcancel then break;
  214.         end;
  215.  
  216.       { Check result }
  217.       if LastPage >= FirstPage then
  218.       begin
  219.         S := 'File: '+ExtractFileName(FileSpec);
  220.         if pcancel then
  221.           FilesName.Caption := 'Printing of '+S+' ABORTED'
  222.         else
  223.         begin
  224.           S := S + '  Pages printed: '+IntToStr(LastPage-FirstPage+1);
  225.           FilesName.Caption := S;
  226.         end
  227.       end;
  228.       pcancel := False;
  229.       {-Restore printer to default state}
  230.       if page_width <> 80 then  { restore it }
  231.         SelectPrintMode(80); { 10.0 cpi }
  232.     finally
  233.       CloseFile(PrintText);
  234.       Screen.Cursor := crDefault;
  235.       SetErrorMode(oldMode);
  236.    end;
  237.   except
  238.     on EInOutError do
  239.     begin
  240.       S := Format('Unable to print text for file: %s'+
  241.       #13+'Check Printer Status', [FileSpec]);
  242.       MessageDlg(S, mtError, [mbOk], 0);
  243.     end;
  244.   end;
  245. end;  {PrintTheFile}
  246.  
  247. procedure TPRNformatDlg.HelpBtnClick(Sender: TObject);
  248. {-Tell user basic use}
  249. begin
  250.   MessageDlg('Select print format options,'+#13+
  251.   'then click on OK to start printing.',
  252.   mtInformation, [mbCancel], 0);
  253. end;
  254.  
  255. procedure TPRNformatDlg.AutoSetCPI;
  256. {-Set up print format}
  257. var
  258.   leadin, MaxLen, ix: integer;
  259. begin
  260.   {Get max line width}
  261.   MaxLen := 0;
  262.   leadin := 0;
  263.   if LineNumbering.Checked then
  264.     leadin := 7;
  265.   for ix := 0 to TextList.Count-1 do
  266.   begin
  267.     if Length(TextList.Strings[ix]) > MaxLen then
  268.       MaxLen := Length(TextList.Strings[ix]);
  269.   end;
  270.   page_width := Widths[0];
  271.   {set page width}
  272.   for ix := 0 to 2 do
  273.     if MaxLen+leadin > Widths[ix] then
  274.       page_width := Widths[ix+1];
  275.   {change pitch to match}
  276.   for ix := 0 to 3 do
  277.     if page_width = Widths[ix] then
  278.       PrintPitch.ItemIndex := ix
  279. end;
  280.  
  281. procedure TPRNformatDlg.SetPrintFactors;
  282. var
  283.   ix: integer;
  284. begin
  285.   { set width}
  286.   if AutoWidth.Checked then
  287.     AutoSetCPI
  288.   else
  289.   begin
  290.     PrintPitch.ItemIndex := 1; {default, 80 col.}
  291.     for ix := 0 to 3 do
  292.       if page_width = Widths[ix] then {get from .INI}
  293.         PrintPitch.ItemIndex := ix;
  294.   end;
  295.   { set lines, pages }
  296.   if HasTitle.Checked then
  297.     PrintLength := LinesPerPage              {set lines per page}
  298.   else
  299.     PrintLength := LinesPerPage+4;           {unformtd lines per page}
  300.   Pages := TextList.Count div PrintLength;
  301.   if TextList.Count mod PrintLength <> 0 then
  302.     inc(Pages);
  303.  
  304.   with SpinEditFirst do
  305.   begin
  306.     MinValue := 1;
  307.     MaxValue := Pages;
  308.     Value := 1;        {set last}
  309.   end;
  310.   with SpinEditLast do
  311.   begin
  312.     MinValue := 1;
  313.     MaxValue := Pages;
  314.     Value := Pages;    {set last}
  315.   end;
  316. end;
  317.  
  318. procedure TPRNformatDlg.OKBtnClick(Sender: TObject);
  319. begin
  320.   page_width := Widths[PrintPitch.ItemIndex];
  321. end;
  322.  
  323. procedure TPRNformatDlg.UpdateLineRange;
  324. {-Show how many lines}
  325. var
  326.   lastline: integer;
  327. begin
  328.   lastline:= SpinEditLast.Value * PrintLength;
  329.   if lastline > TextList.Count then
  330.     lastline := TextList.Count;
  331.   LinesLabel.Caption := Format('Lines %4d to %4d',
  332.   [((SpinEditFirst.Value - 1) * PrintLength)+1, lastline]);
  333. end;
  334.  
  335. procedure TPRNformatDlg.SpinEditFirstChange(Sender: TObject);
  336. begin
  337.   if SpinEditFirst.Value > SpinEditLast.Value then
  338.   begin
  339.     MessageBeep(0);
  340.     SpinEditFirst.Value := SpinEditLast.Value;
  341.   end
  342.   else
  343.     UpdateLineRange;
  344. end;
  345.  
  346. procedure TPRNformatDlg.SpinEditLastChange(Sender: TObject);
  347. begin
  348.   if SpinEditLast.Value < SpinEditFirst.Value then
  349.   begin
  350.     MessageBeep(0);
  351.     SpinEditLast.Value := SpinEditFirst.Value;
  352.   end
  353.   else
  354.     UpdateLineRange;
  355. end;
  356.  
  357. procedure TPRNformatDlg.HasTitleClick(Sender: TObject);
  358. begin
  359.   if Visible then
  360.     SetPrintFactors;
  361. end;
  362.  
  363. procedure TPRNformatDlg.AutoWidthClick(Sender: TObject);
  364. begin
  365.   if Visible and AutoWidth.Checked then
  366.     AutoSetCPI
  367. end;
  368.  
  369. end.
  370.